home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / lisp / elk-2_0.lha / elk-2.0 / contrib / zelk / scm / parlet.e < prev    next >
Encoding:
Text File  |  1992-11-13  |  16.6 KB  |  533 lines
  1. ;; parlet.e zilla 19apr - dataparallel expression compiler
  2. ;; modified 
  3. ;; 16june    parletv macros work properly
  4. ;; 8june    builtin v-arith ops are now scalar/vector overloaded
  5. ;; 4may        comment
  6. ;; test expressions by: (pp (expand expr))
  7. ;;
  8. ;; possible bug in collect code: look is correct, but inner operators
  9. ;; are translated to vector, e.g. in:
  10. ;; (parlet (a) (unknown-scalar-func (- a b)))
  11. ;; - is incorrectly translated to v--
  12. ;;
  13. ;; (parlet <bindings> <body>)
  14. ;; <bindings> mention all variables (and functions) which body should
  15. ;; 'vectorize over'.  Bindings are like a let list.
  16. ;; Any variables in body not mentioned in bindings are treated as scalars
  17. ;; and are promoted to vectors as necessary.
  18. ;; All variables mentioned in letbindings must have the same size.
  19. ;; Any functions in body not mentioned in bindings (and not known
  20. ;; to the compiler as builtin vector functions) are treated as scalar->scalar
  21. ;; functions and are replaced by a loop over vector arguments if necessary.
  22. ;; All functions in the body must be either scalar->scalar or 
  23. ;; vector->vector, and the types of their arguments must match
  24. ;; after the elevation applied by this compiler.
  25. ;; Thus, can assume that the types (vector/scalar) of all functions are known.
  26. ;;>Mixed type scalar->vector expressions such as v-index should be moved 
  27. ;; into the bindings, and vector->scalar expressions such as farray-ref
  28. ;; should be moved into a surrounding let.
  29. ;;
  30. ;; Why not just treat all vector-bound variables in body as vectors?
  31. ;; 1. Parallation lisp book p.21 argues that this is like dynamic scoping.
  32. ;; Dynamic typing is easy for an interpreter but hard for a compiler--
  33. ;; It can be difficult for a compiler to tell whether a variable currently 
  34. ;; contains a vector (without doing some kind of type inferencing or
  35. ;; executing the program!).
  36. ;; With bindings the parallel variables are lexically obvious.
  37. ;;>Keep this approach--parlet will flag interesting places in the source
  38. ;; and will help compilation in the distant future.
  39. ;; 2. Making all functions accept any combination of scalar/vector
  40. ;; requires ugly programming--see ARITHOP--currently arith ops allow this
  41. ;; but comparisons do not.  Simplifies fvector.c.
  42. ;; 3. It is not desirable to elevate all expressions involving vectors
  43. ;; to vector type.  Parallation Lisp book gives an example of this:
  44. ;; x,y:lists; (elwise ((x)) (cons x y)) ==> ( (x_1 . y) (x_2 . y) ...) 
  45. ;; versus (elwise ((x)(y)) (cons x y)) ==> ( (x_1 . y_1) (x_2 . y_2) ...)
  46. ;; It is less relevant here, because the only datatype we use is the
  47. ;; homogeneous foreign array.
  48. ;;
  49. ;; Consider vector->scalar, scalar->vector cases in more detail:
  50. ;;-vector->scalar e.g. farray-ref:  This is only a problem if
  51. ;; the argument is used elsewhere in the same parlet as a vector,
  52. ;; e.g. (parlet ((v)) (func v (farray-length v)))
  53. ;; because, in this case, parlet does not know that farray-length returns
  54. ;; a scalar, and the resulting arg to func is not promoted.
  55. ;; This can be written as
  56. ;;  (let ((len (farray-length v)))  (parlet ((v)) (* v len)))
  57. ;;-scalar->vector e.g. (parlet ((v)) (* v (v-rnd n)))
  58. ;; This can be written as
  59. ;;  (parlet ((v) (w (v-rnd n))) (* v w))
  60. ;; Both of these cases could be handled by putting more intelligence
  61. ;; into the v-ops: the vector->scalar would be solved by making
  62. ;; the v-ops elevate any scalar args to vector; the scalar->vector
  63. ;; case could be handled by having distribute return any vector argument
  64. ;; unchanged.  Both cases make use of the fact that argument types
  65. ;; are easily known at run time in an interpreter.
  66. ;;
  67. ;; Desired behavior:
  68. ;; (parlet () (+ 2 v))         => (let () (+ 2 v))
  69. ;; (parlet ((v)) (+ 2 v))     => (v-+ (v-distribute 2 v) v)
  70. ;; (parlet ((v)) (+ v (+ 2 3)))    => (v-+ v (v-distribute (+ 2 3) v))
  71. ;;            NOT       (v-+ v (v-+ (v-distribute 2) (v-dist....
  72. ;; (parlet ((v (% 1 2))) (* v 2) => (let ((v (% 1 2)))
  73. ;;                    (v-* v (v-distribute 2 v)))
  74. ;; (parlet ((v)) (+ x v))    => (v-+ (v-distribute x v) v)
  75. ;; (parlet (...) (set! v ...))    => set! is not vectorized
  76. ;; 
  77. ;; To debug, use parlet[*]v form, or do (pp (macro-expand '(parlet...))).
  78. ;; Explicit v- functions of non-parlet variables are ok as long
  79. ;; as they reduce the vector to a scalar, for example:
  80. ;; (parlet ((v)) (set! v (+/ x))) => ok, but
  81. ;; (parlet ((v)) (set! v (v-index n))) => (set! v (distribute (v-index..
  82. ;; Express this as (parlet ((v (v-index n))) ...)
  83. ;; Explicit v- functions of parlet variables are ok when they
  84. ;; do not reduce the vector, but they are generally unneeded.
  85.  
  86. (provide 'parlet.e)
  87.  
  88. ;; generate debugging length-checking code at the beginning of each function?
  89. (define *parlet-gendebug* #f)
  90.  
  91. ;; trace the compilation
  92. (define *parlet-trace* #f)
  93.  
  94. ;; to identify nested parlets
  95. (if (not (bound? 'parlet-let))
  96.     (define parlet-let let))
  97. (if (not (bound? 'parlet-let*))
  98.     (define parlet-let* let*))
  99.  
  100. ;; function translation table
  101. (define *parlet-functions* 
  102. '(
  103.   (append v-append)
  104.  
  105.   (sin v-sin)
  106.   (cos v-cos)
  107.   (sqrt v-sqrt)
  108.   (exp v-exp)
  109.   (abs v-abs)
  110.   (not v-not)
  111.   (rnd v-rnd)
  112.   (pow v-pow)
  113.   (truncate v-truncate)
  114.  
  115.   (* v-*)
  116.   (+ v-+)
  117.   (/ v-/)
  118.   (- v--)
  119.  
  120.   (if v-select)
  121.   (eq? v-eq)
  122.   (eqv? v-eq)
  123.   (equal? v-eq)
  124.   (= v-eq)
  125.   (< v-lt)
  126.   (<= v-le)
  127.   (> v-gt)
  128.   (>= v-ge)
  129.   (and v-and)
  130.   (or v-or)
  131.  
  132.   ;side effects!
  133.   (set! set!)
  134. ));parlet-functions
  135.  
  136. ;; these functions (only) take any of 4 mixtures of scalar/vector arguments.
  137. (define *parlet-overloaded* '( + - * / min max fmod ))
  138.  
  139. ;; generate unique symbols to avoid name capture
  140. (define *parlet-counter* 0)
  141. (define (parlet-gensym sym)
  142.   (if (symbol? sym) (set! sym (symbol->string sym)))
  143.   (set! *parlet-counter* (1+ *parlet-counter*))
  144.   (string->symbol (string-append sym "$" (number->string *parlet-counter*))))
  145.  
  146. (define (parlet-lookup sym)
  147.   (assoc sym *parlet-functions*))
  148.  
  149. ;; is symbol mentioned in bindings anywhere?
  150. (define (parlet-inbindings? sym bindings)
  151.   (or (assoc sym bindings)
  152.       (member sym bindings)))
  153.  
  154. ;; is the function known to be a vector function?
  155. (define (parlet-vectorfunc? newe bindings)
  156.   (let ((func (car newe)))
  157.     (cond
  158.      ((list? func) #f)
  159.      ((parlet-lookup func) #t)
  160.      ((parlet-inbindings? func bindings) #t)
  161.      (#t #f)
  162.     ))
  163. ) ;vectorfunc?
  164.  
  165.  
  166. ;;;;;;;;;;;;;;;; the top-level macros
  167.  
  168. ;; decomposing this into parlet, parlet-make and passing the
  169. ;; let type (let,let*) to parlet-make is cleaner, but
  170. ;; this does not work with our mdefine system--elk macros
  171. ;; are interpreted at run time rather than at read time
  172. ;; unless you do something special.  see .elkrc.
  173. (define-macro (parlet bindings . body)
  174.   (let ((newbindings (parlet-newbindings bindings)))
  175.   `(parlet-let ,newbindings
  176.      ,@(if *parlet-gendebug* (parlet-debug bindings) '())
  177.      ,@(parlet-compile-toplevel body bindings)
  178.    ))
  179. );parlet
  180.  
  181.  
  182. ;; test version. is not a macro, just returns the result
  183. (define (parlett bindings . body)
  184.   (let ((newbindings (parlet-newbindings bindings)))
  185.   `(parlet-let ,newbindings
  186.      ,@(if *parlet-gendebug* (parlet-debug bindings) '())
  187.      ,@(parlet-compile-toplevel body bindings)
  188.    ))
  189. );parlet
  190.  
  191.  
  192. (define-macro (parlet* bindings . body)
  193.   (let ((newbindings (parlet-newbindings bindings)))
  194.   `(let* ,newbindings
  195.      ,@(if *parlet-gendebug* (parlet-debug bindings) '())
  196.      ,@(parlet-compile-toplevel body bindings)
  197.    ))
  198. );parlet
  199.  
  200. ;; verbose/testing versions
  201. (define-macro (parletv bindings . body)
  202.   (let ((e (macro-expand `(parlet ,bindings ,@body))))
  203.     (pp e) (newline)
  204.     (let ((newbindings (parlet-newbindings bindings)))
  205.       `(let ,newbindings
  206.      ,@(if *parlet-gendebug* (parlet-debug bindings) '())
  207.      ,@(parlet-compile-toplevel body bindings)
  208.        )
  209.     )))
  210.  
  211. (define-macro (parlet*v bindings . body)
  212.   (let ((e (macro-expand `(parlet* ,bindings ,@body))))
  213.     (pp e) (newline)
  214.     (let ((newbindings (parlet-newbindings bindings)))
  215.       `(let* ,newbindings
  216.      ,@(if *parlet-gendebug* (parlet-debug bindings) '())
  217.      ,@(parlet-compile-toplevel body bindings)
  218.        )
  219.     )))
  220.  
  221. ;;(define-macro (parlet* bindings . body)
  222. ;;  (parlet-make 'let* bindings body))
  223. ;;
  224. ;; beware, in calling this directly, body is a list of expressions,
  225. ;; not a single expression.  if given a single expression, 
  226. ;; it will come back with the outer parentheses stripped.
  227. (define (parlet-make lettype bindings body)
  228.   (let ((newbindings (parlet-newbindings bindings)))
  229.   `(,lettype ,newbindings
  230.      ,@(if *parlet-gendebug* (parlet-debug bindings) '())
  231.      ,@(cadr (parlet-compile body bindings)))
  232.    )
  233. );parlet
  234.  
  235.  
  236. ; something like this would work in lisp but not in scheme - 
  237. ; it leaves empty () or #fs in the list 
  238. ;(define (parlet-newbindings bindings)
  239. ;  (map (lambda (x) (if (> (length x) 1) x '()) ) bindings))
  240.  
  241.  
  242. ;; Bindings can contain new variables, e.g., (x (% 1 2 3))
  243. ;; and existing variables that are declared as parallel, e.g., (y).
  244. ;; Find the new variables and return a list of them so they
  245. ;; can be put in a let.
  246. (define (parlet-newbindings bindings)
  247.   (let ((new '()))
  248.     (dolist (i bindings)
  249.         (if (and (list? i) (>  (length i) 1))
  250.         (set! new (cons i new))))
  251.     (reverse new)))
  252.  
  253.  
  254. ;; generate vector length conformance debugging checks
  255. (define (parlet-debug bindings)
  256.   (if (> (length bindings) 1)
  257.       `((let ((len (farray-length ,(caar bindings))))
  258.      ,@(map (lambda (x)
  259.          `(if (not (equal? len (farray-length ,(car x))))
  260.               (error 'vector "vectors size mismatch")))
  261.            (cdr bindings))
  262.      ))
  263.       ))
  264.  
  265.  
  266. ;; indentation for compilation tracing
  267. (define parlet-reclevel 0)
  268. (define parlet-indentstr "")
  269.  
  270. (define (parlet-indent)
  271.   (set! parlet-reclevel (+ parlet-reclevel 2))
  272.   (set! parlet-indentstr "")
  273.   (dotimes (i parlet-reclevel)
  274.     (set! parlet-indentstr (string-append parlet-indentstr " ")))
  275. )
  276.  
  277. (define (parlet-dedent)
  278.   (set! parlet-reclevel (- parlet-reclevel 2))
  279.   (set! parlet-indentstr "")
  280.   (dotimes (i parlet-reclevel)
  281.     (set! parlet-indentstr (string-append parlet-indentstr " ")))
  282. )
  283.  
  284. (define (parlet-trace msg . args)
  285.   (if *parlet-trace*
  286.       (apply format (cons #t (cons (string-append "~a" msg)
  287.                    (cons parlet-indentstr args)))))
  288. )
  289.  
  290.  
  291. ;; names of parlet forms.
  292. ;; used to look for nested parlets.
  293. (define *parlet-names* '(parlet-let parlet-let* parletv parlet*v))
  294.  
  295.  
  296. ;; the translator--translate the top-level parlet body
  297. ;; Unlike parlet-compile (below), do not elevate non-vector expressions
  298. (define (parlet-compile-toplevel body bindings)
  299.   (map (lambda (x)
  300.      (if (list? x)
  301.          (cadr (parlet-compile x bindings))
  302.          x))
  303.    body)
  304. );compile-toplevel
  305.  
  306.  
  307. ;; translate one expression.  called recursively.
  308. (define (parlet-compile e bindings)
  309.   (parlet-trace "parlet-compile <~a> ~a~%" bindings e)
  310.   (parlet-indent)
  311.  
  312.   (let* ((m #f) (types #f) (newe #f) (maxtype #f) (subparlet #f))
  313.  
  314.     ;; 1. change expression to a list of (type expression subparlet?),
  315.     ;; recursively compile any subexpressions which are lists
  316.     (set! m
  317.      (map (lambda (x)
  318.         (parlet-trace "  map> ~a~%" x)
  319.         (cond
  320.          ((and (list? x) (not (null? x))
  321.                (member (car x) *parlet-names*))
  322.           (list 'vector x #t))
  323.  
  324.          ((list? x)
  325.           (parlet-compile x bindings))
  326.  
  327.          (#t
  328.           (list (parlet-type x bindings) x #f))
  329.         );cond
  330.           );lambda
  331.      e);map
  332.     );set!m
  333.     (parlet-trace "parlet-compile m ~a~%" m)
  334.  
  335.     ;; extract the types from step 1.
  336.     (set! types (map (lambda (x) (car x)) m))
  337.     (parlet-trace "parlet-compile types ~a~%" types)
  338.     
  339.     ;; extract the expression from step 1.
  340.     ;; this differs from e in that any sub-expressions are now
  341.     ;; compiled
  342.     (set! newe (map (lambda (x) (cadr x)) m))
  343.     (parlet-trace "parlet-compile newe ~a~%" newe)
  344.  
  345.     (set! subparlet (if m (member #t (map (lambda (x) (list-ref x 2)) m))))
  346.     (parlet-trace "parlet-compile subparlet ~a~%" subparlet)
  347.     (if subparlet (error 'parlet "nested parlet not implemented"))
  348.  
  349.     ;; 2. see if any elements of the current expression are vector
  350.     (set! maxtype (if (member 'vector types) 'vector #f))
  351.     (parlet-trace "parlet-compile maxtype ~a~%" maxtype)
  352.  
  353.     ;; 3. if so, elevate all to vector, except arguments to one
  354.     ;; of the *overloaded* functions, which can take mixed scalar/vector args.
  355.     ;; If the function arg is an expression rather than a symbol,
  356.     ;; this may needlessly distribute arguments to a *overloaded* function,
  357.     ;; but this is just slower, not incorrect.
  358.     ;;
  359.     (if (equal? maxtype 'vector)
  360.     (set! newe
  361.           (if subparlet        ;nested parlets?
  362.           (parlet-compile-outer newe bindings maxtype)
  363.           ;; else not nested
  364.           (if (parlet-vectorfunc? newe bindings)
  365.               ;; vectorized
  366.               (parlet-compile-inner newe bindings maxtype types)
  367.               ;; simulated vectorization
  368.               (parlet-compile-innerloop newe bindings maxtype types)
  369.           )
  370.           ))
  371.     );if
  372.     (parlet-dedent)
  373.  
  374.     ;; return a list maxtype,newe to the caller
  375.     (list maxtype newe (or (member (car newe) *parlet-names*)
  376.                subparlet))
  377.   );let*
  378. );-compile
  379.  
  380.  
  381.  
  382. ;; a scalar func has been called with (some) vector args.
  383. ;; Expand into a simulated vector loop.  Example:
  384. ;; (parlet (x) (f x)) ==>
  385. ;; (let* ((x-tmp x) 
  386. ;;        (len-tmp (farray-length x))
  387. ;;        (collect-tmp (farray (farray-type x) len-tmp)))
  388. ;;   (dolist (i-tmp len-tmp)
  389. ;;      (let ((x (farray-ref x-tmp i-tmp)))
  390. ;;        (farray-set! collect-tmp i-tmp
  391. ;;            (f x))))
  392. ;; collect-tmp)
  393. ;;
  394. (define (parlet-compile-innerloop newe bindings maxtype types)
  395.   (parlet-trace "parlet-compile-innerloop ~a~%" newe)
  396.  
  397.   (let* ((i (parlet-gensym "i"))
  398.     (len (parlet-gensym "len"))
  399.     (collect (parlet-gensym "collect"))
  400.     (bind (parlet-outerbindings bindings i len)))
  401.   `(let* (,@(car bind)
  402.       (,collect (farray (farray-type ,(if (symbol? (car bindings))
  403.                       (car bindings) (caar bindings)))
  404.                 ,len))
  405.      )
  406.      (dotimes (,i ,len)
  407.     (let* ,(list-ref bind 1)
  408.       (farray-set! ,collect ,i  ,newe)
  409.     ))
  410.   ,collect);quasilet
  411.   )
  412. ) ;parlet-compile-innerloop
  413.  
  414.  
  415. ;; helper to compile-innerloop
  416. ;; return a list (outer,inner)
  417. ;; outer rename each bindings variable to a unique tmp variable
  418. ;; inner rebinds each bindings variable to a reference to outer tmps
  419. ;; example
  420. ;; bindings => ((x) (y (v-index res)))
  421. ;; ( ( (x-gen x)        ;outer
  422. ;;     (y-gen (v-index res)))    
  423. ;;   ( (x (farray-ref x-gen i-gen)) ;inner
  424. ;;     (y (farray-ref y-gen i-gen)))
  425. ;; )
  426. (define (parlet-outerbindings bindings iter len)
  427.   (parlet-trace "parlet-outerbindings~%")
  428.   (let* ((firstsym (if (list? (car bindings)) (caar bindings) (car bindings)))
  429.      (outer `((,len (farray-length ,firstsym))))
  430.      (inner '()))
  431.     (dolist (i bindings)
  432.       (let* ((isym (if (list? i) (car i) i))
  433.          (ialias (parlet-gensym isym)))
  434.     ;(format #t "~a -> ~a~%" i ialias)
  435.     (set! outer (cons
  436.              (if (or (not (list? i)) (= (length i) 1))
  437.              `(,ialias ,isym)
  438.              `(,ialias ,(cadr i)))
  439.              outer))
  440.     (set! inner (cons `(,isym (farray-ref ,ialias ,iter)) inner))
  441.       )
  442.     )
  443.   (list (reverse! outer) (reverse! inner))
  444. )) ;parlet-outerbindings
  445.  
  446.  
  447. ;; vectorize (non-nested or inner) parlet call
  448. (define (parlet-compile-inner newe bindings maxtype types)
  449.   (parlet-trace "parlet-compile-inner {~a}~%" newe)
  450.   (let ((needs-distribute
  451.      (not (member (car newe) *parlet-overloaded*))))
  452.     ;(format #t "~a needs-distribute ~a~%" newe needs-distribute)
  453.     (set! newe
  454.       (map (lambda (x t)
  455.          (let ((functionp (eq? x (car newe))))
  456.            (if (or functionp
  457.                (and (not (eq? t 'vector)) needs-distribute))
  458.                (parlet-elevate x maxtype bindings functionp)
  459.                x)))
  460.            newe types))
  461.     (parlet-trace "parlet-compile-inner elevated ~a~%" newe)
  462.   );let
  463. newe)
  464.  
  465.  
  466.  
  467. ;; return the type of expression e; 
  468. ;; bindings are let-type bindings which mention ALL parallel symbols.
  469. ;; Currently, types are 'vector for an farray or symbol mentioned
  470. ;; in the bindings, #f for everything else.
  471. (define (parlet-type e bindings)
  472.   (cond
  473.    ((list? e)
  474.     (error 'parlet-type "foo"))
  475.  
  476.    ((symbol? e)
  477.     (if (parlet-inbindings? e bindings)
  478.     'vector
  479.     #f))
  480.    
  481.    ((farray? e) 'vector)
  482.  
  483.    (#t #f)
  484.   );cond
  485. );-type
  486.  
  487.  
  488. ;; elevate expression to vector.
  489. ;; Pass in bindings because the size of expressions elevated
  490. ;; by distribute is needed and can be obtained from any of the
  491. ;; parlet-bound symbols.
  492. (define (parlet-elevate e typ bindings functionp)
  493.   (parlet-trace "parlet-elevate: ~a~%" e)
  494.   (if (not (equal? typ 'vector))
  495.       (error 'parlet-elevate "logic error"))
  496.  
  497.   (cond
  498.    ((list? e)
  499.     `(v-distribute ,e ,(caar bindings)))
  500.    ((symbol? e)
  501.     (let ((newe (parlet-lookup e)))
  502.       (if newe
  503.       (cadr newe)
  504.       (if (not functionp)
  505.           `(v-distribute ,e ,(caar bindings))
  506.           e)
  507.       )))
  508.    ((number? e)
  509.     `(v-distribute ,e ,(caar bindings)))
  510.    ((farray? e)
  511.     e)
  512.    (#t
  513.     (format #t "warning: v-compiler does not recognize ~s~%" e)
  514.     e)
  515.   );cond
  516. );-elevate
  517.  
  518. ;;;;;;;;;;;;;;;; NOT YET ;;;;;;;;;;;;;;;;
  519.  
  520. ;; nice test expression for nested parlets.
  521. ;; how to avoid elevating the fp,y args to GR-wrrow?
  522. ;; 
  523. (define parlet-test
  524. '(let ((x (v-index xres)))
  525.    (parlet ((y (v-index yres)))
  526.      (GR-wrrow fp y
  527.        (parlet ((x)) (* x y)))
  528.      0.)
  529.  ))
  530.  
  531.  
  532.  
  533.